home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / docume1a / frmabout (.txt) < prev    next >
Visual Basic Form  |  1999-03-03  |  10KB  |  228 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout1 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About Document Editor"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2453.724
  14.    ScaleMode       =   0  'User
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.TextBox Text1 
  18.       BackColor       =   &H80000004&
  19.       Height          =   285
  20.       Left            =   1560
  21.       Locked          =   -1  'True
  22.       TabIndex        =   5
  23.       Top             =   2880
  24.       Width           =   975
  25.    End
  26.    Begin VB.PictureBox picIcon 
  27.       AutoSize        =   -1  'True
  28.       ClipControls    =   0   'False
  29.       Height          =   540
  30.       Left            =   240
  31.       Picture         =   "frmAbout1.frx":0000
  32.       ScaleHeight     =   337.12
  33.       ScaleMode       =   0  'User
  34.       ScaleWidth      =   337.12
  35.       TabIndex        =   1
  36.       Top             =   240
  37.       Width           =   540
  38.    End
  39.    Begin VB.CommandButton cmdOK 
  40.       Cancel          =   -1  'True
  41.       Caption         =   "OK"
  42.       Default         =   -1  'True
  43.       Height          =   345
  44.       Left            =   4245
  45.       TabIndex        =   0
  46.       Top             =   2625
  47.       Width           =   1260
  48.    End
  49.    Begin VB.CommandButton cmdSysInfo 
  50.       Caption         =   "&System Info..."
  51.       Height          =   345
  52.       Left            =   4260
  53.       TabIndex        =   2
  54.       Top             =   3075
  55.       Width           =   1245
  56.    End
  57.    Begin VB.Label Label1 
  58.       AutoSize        =   -1  'True
  59.       Caption         =   "Version:"
  60.       BeginProperty Font 
  61.          Name            =   "MS Sans Serif"
  62.          Size            =   9.75
  63.          Charset         =   0
  64.          Weight          =   700
  65.          Underline       =   0   'False
  66.          Italic          =   0   'False
  67.          Strikethrough   =   0   'False
  68.       EndProperty
  69.       Height          =   240
  70.       Left            =   600
  71.       TabIndex        =   6
  72.       Top             =   2880
  73.       Width           =   870
  74.    End
  75.    Begin VB.Line Line1 
  76.       BorderColor     =   &H00808080&
  77.       BorderStyle     =   6  'Inside Solid
  78.       Index           =   1
  79.       X1              =   84.515
  80.       X2              =   5309.398
  81.       Y1              =   1687.583
  82.       Y2              =   1687.583
  83.    End
  84.    Begin VB.Label lblDescription 
  85.       Caption         =   "Application that lets the user do multiple things using the document editor."
  86.       ForeColor       =   &H00000000&
  87.       Height          =   810
  88.       Left            =   1080
  89.       TabIndex        =   3
  90.       Top             =   1125
  91.       Width           =   3885
  92.    End
  93.    Begin VB.Label lblTitle 
  94.       Caption         =   "Marc's Document Editor"
  95.       ForeColor       =   &H00000000&
  96.       Height          =   360
  97.       Left            =   1080
  98.       TabIndex        =   4
  99.       Top             =   240
  100.       Width           =   1965
  101.    End
  102.    Begin VB.Line Line1 
  103.       BorderColor     =   &H00FFFFFF&
  104.       BorderWidth     =   2
  105.       Index           =   0
  106.       X1              =   98.6
  107.       X2              =   5309.398
  108.       Y1              =   1697.936
  109.       Y2              =   1697.936
  110.    End
  111. Attribute VB_Name = "frmAbout1"
  112. Attribute VB_GlobalNameSpace = False
  113. Attribute VB_Creatable = False
  114. Attribute VB_PredeclaredId = True
  115. Attribute VB_Exposed = False
  116. Option Explicit
  117. ' Reg Key Security Options...
  118. Const READ_CONTROL = &H20000
  119. Const KEY_QUERY_VALUE = &H1
  120. Const KEY_SET_VALUE = &H2
  121. Const KEY_CREATE_SUB_KEY = &H4
  122. Const KEY_ENUMERATE_SUB_KEYS = &H8
  123. Const KEY_NOTIFY = &H10
  124. Const KEY_CREATE_LINK = &H20
  125. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  126.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  127.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  128.                      
  129. ' Reg Key ROOT Types...
  130. Const HKEY_LOCAL_MACHINE = &H80000002
  131. Const ERROR_SUCCESS = 0
  132. Const REG_SZ = 1                         ' Unicode nul terminated string
  133. Const REG_DWORD = 4                      ' 32-bit number
  134. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  135. Const gREGVALSYSINFOLOC = "MSINFO"
  136. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  137. Const gREGVALSYSINFO = "PATH"
  138. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  139. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  140. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  141. Private Sub cmdSysInfo_Click()
  142.   Call StartSysInfo
  143. End Sub
  144. Private Sub cmdOK_Click()
  145.   Unload Me
  146. End Sub
  147. Private Sub Form_Load()
  148.     Me.Caption = "About " & App.Title
  149.   '  lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  150.     lblTitle.Caption = App.Title
  151. Text1.Text = Version
  152. End Sub
  153. Public Sub StartSysInfo()
  154.     On Error GoTo SysInfoErr
  155.     Dim rc As Long
  156.     Dim SysInfoPath As String
  157.     ' Try To Get System Info Program Path\Name From Registry...
  158.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  159.     ' Try To Get System Info Program Path Only From Registry...
  160.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  161.         ' Validate Existance Of Known 32 Bit File Version
  162.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  163.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  164.             
  165.         ' Error - File Can Not Be Found...
  166.         Else
  167.             GoTo SysInfoErr
  168.         End If
  169.     ' Error - Registry Entry Can Not Be Found...
  170.     Else
  171.         GoTo SysInfoErr
  172.     End If
  173.     Call Shell(SysInfoPath, vbNormalFocus)
  174.     Exit Sub
  175. SysInfoErr:
  176.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  177. End Sub
  178. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  179.     Dim i As Long                                           ' Loop Counter
  180.     Dim rc As Long                                          ' Return Code
  181.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  182.     Dim hDepth As Long                                      '
  183.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  184.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  185.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  186.     '------------------------------------------------------------
  187.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  188.     '------------------------------------------------------------
  189.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  190.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  191.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  192.     KeyValSize = 1024                                       ' Mark Variable Size
  193.     '------------------------------------------------------------
  194.     ' Retrieve Registry Key Value...
  195.     '------------------------------------------------------------
  196.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  197.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  198.                         
  199.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  200.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  201.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  202.     Else                                                    ' WinNT Does NOT Null Terminate String...
  203.         tmpVal = Left(tmpVal, KeyVa